perm filename CONTRL.SAI[SYS,HE] blob
sn#099606 filedate 1974-05-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00007 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "CONTRL"
C00006 00003 ⊃ GETVAL, FOOL, SCN
C00009 00004 HERE ARE OUR MESSAGE PROCEDURES
C00018 00005 MAIN PROGRAM STARTS HERE
C00020 00006 IF BITS LAND '10 THEN
C00022 00007
C00024 ENDMK
C⊗;
BEGIN "CONTRL"
REQUIRE "SYS:PROCES.DEF" SOURCE_FILE;
REQUIRE "EDGLIB.REL[SYS,HE]" LIBRARY;
REQUIRE "HELIB.REL[1,3]" LIBRARY;
REQUIRE 100 SYSTEM_PDL;
REQUIRE 700 STRING_SPACE;
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "EDGE[SYS,HE]" LOAD_MODULE;
REQUIRE "MISEDG[SYS,HE]" LOAD_MODULE;
REQUIRE "SCANER[SYS,HE]" LOAD_MODULE;
REQUIRE "INNER[SYS,HE]" LOAD_MODULE;
DEFINE CX="12",TTY="1", LPT="2", ⊃="COMMENT",
CR="'15", LF="'12", CRLF="CR&LF", TAB="'11", TJOB="EQU(""TTY"",JOB)";
SAFE INTEGER ARRAY LPSFRE[1:1000];
PRELOAD_WITH "DISK","SETVAL","FIND","FIT","COMPACT","REJECT",
"RELOOK","FINE","GETDATA","GETVAL","GLBDMP","GETSTATUS";
SAFE STRING ARRAY COMND[0:CX];
PRELOAD_WITH 1,'32,6,6,6,6,6,6,6,2,4,6;
SAFE INTEGER ARRAY STATBITS[0:CX];
SHORT INTEGER I,J,BRK,ARG,TARG,STATUS,BITS, ARGT;
EXTERNAL SHORT INTEGER XSTRT, YSTRT, TVWORD, PTYDPY, DISSIZ,INIT;
BOOLEAN FLAGX, AFLAG, FLAG, FLAGY;
STRING ANS, VERB, ARGSTR, ARGTWO, DSKSTRING, INP;
LABEL INPT, INPTX, ERRCOM, ERRARG, XEQL;
EXTERNAL BOOLEAN ACCOMINIT, EDGINIT;
INTERNAL STRING JOB;
ITEMVAR IARG, T;
INTERNAL SET FNDBLB;
EXTERNAL BOOLEAN PROCEDURE LOOK(REFERENCE ITEMVAR ARG; REFERENCE INTEGER ING;
INTEGER X, Y);
EXTERNAL INTEGER PROCEDURE XGETD(LIST OBJS; STRING JOB);
EXTERNAL INTEGER PROCEDURE XGETS(LIST OBJS;REAL TOP,BOT,LFT,RT;STRING JOB);
EXTERNAL PROCEDURE INITLPS(INTEGER A);
EXTERNAL PROCEDURE DISINT;
EXTERNAL BOOLEAN PROCEDURE INITDK(STRING NAME);
EXTERNAL PROCEDURE SEINT(INTEGER A, B, C, D, E);
EXTERNAL BOOLEAN PROCEDURE EDGE_KKP(REFERENCE ITEMVAR A;REFERENCE INTEGER S);
EXTERNAL PROCEDURE CURVE(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE REJSUB(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE COMP(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE XFINE(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL INTEGER PROCEDURE GIOWD(INTEGER ARRAY A);
EXTERNAL BOOLEAN PROCEDURE SUBLNK(STRING FOO);
EXTERNAL PROCEDURE SAIINT(BOOLEAN A,B,C);
EXTERNAL INTEGER PROCEDURE SLINK(STRING NAME);
EXTERNAL PROCEDURE INITTV;
EXTERNAL PROCEDURE DEFLT;
EXTERNAL PROCEDURE INTWAIT;
EXTERNAL PROCEDURE INTSTR;
⊃ GETVAL, FOOL, SCN;
COMMENT BITS IN STATBITS FOR COMMAND DECODER
1 NO ARGUMENTS
2 ONE ARGUMENT EXISTS
4 ARGUMENT IS NUMBER
10 SECOND ARGUMENT EXISTS
20 SECOND ARGUMENT IS NUMBER;
COMMENT GET VALUE OF VARIABLE;
SIMPLE PROCEDURE GETVAL(STRING ARGSTR; REFERENCE BOOLEAN FLAG);
BEGIN SHORT INTEGER I, FLG;
REAL J;
FLG ← FALSE;
IF FLAG←(I←SLINK(ARGSTR))>0 THEN
START_CODE DEFINE MOVE="'200000000000";
MOVE 1,I;
MOVE 1,(1);
MOVEM 1,I;
MOVEM 1,J;
MOVM 2,1;
TLNE 2,'777000;
SETOM FLG;
END ELSE RETURN;
SETFORMAT(10,4);
OUTSTR((IF ¬FLG THEN (CVOS(I)&CVS(I)) ELSE (CVF(J)))&CRLF);
FLAG ← TRUE;
END;
SIMPLE INTEGER PROCEDURE FOOL(REAL A);
START_CODE DEFINE MOVE="'200000000000";
MOVE 1,A;
END;
COMMENT SCAN ONE LINE FOR NEXT WORD OR NUMBER
STRING A IS EATEN AS SCANNED
B IS BREAK CHAR
FLAGX (GLOBAL) IS TRUE IF STRING IS A NUMBER
FLAGY (GLOBAL) IS TRUE IF A FLOATING POINT NUMBER IS SEEN;
SIMPLE STRING PROCEDURE SCN(REFERENCE STRING A; REFERENCE SHORT INTEGER B);
BEGIN STRING FOO, FA;
SHORT INTEGER C;
SCAN(A,5,B);
FA ← FOO ← SCAN(A,1,B);
SCAN(FA,2,C);
FLAGX ← ¬C;
SCAN(FA←FOO,3,C);
FLAGY←C;
RETURN(FOO);
END;
COMMENT HERE ARE OUR MESSAGE PROCEDURES;
COMMENT RESPONSE PROCEDURE;
SIMPLE PROCEDURE RESP(ITEMVAR ARG; SHORT INTEGER STATUS; STRING NAME);
IF TJOB THEN
BEGIN
AFLAG ← TRUE;
OUTSTR(NAME&(IF ARG=NIL THEN " NIL" ELSE " "
&CVS(CVN(ARG)))&" "&
(IF STATUS≥0 THEN CVOS(STATUS) ELSE
CVS(STATUS))&CRLF);
END ELSE ISSUE(5,"EDGE",JOB,
MESSAGE RESPONSE(NAME,CVN(ARG),STATUS));
DEFINE PROC(A,B)="
MESSAGE PROCEDURE A(ITEMVAR ARG);
BEGIN ITEMVAR T;
T ← ARG;
DO BEGIN
B(ARG,STATUS←0);
RESP(ARG,STATUS,""A"");
IF T=EVERY∧ARG≠NIL THEN ARG←T;
END UNTIL T≠EVERY∨ARG=NIL;
END";
MESSAGE PROCEDURE FIND(ITEMVAR ARG);
BEGIN ITEMVAR T;
T ← ARG;
DO BEGIN
EDGE_KKP(ARG,STATUS);
IF T=EVERY∧ARG≠NIL THEN ARG←T;
END UNTIL T≠EVERY∨ARG=NIL;
IF STATUS≥0 THEN STATUS←-1;
RESP(NIL,STATUS,"FIND");
IF ARG=NIL THEN XSTRT←YSTRT←0;
END;
PROC(FIT,CURVE);
PROC(COMPACT,COMP);
PROC(REJECT,REJSUB);
PROC(FINE,XFINE);
MESSAGE PROCEDURE RELOOK(ITEMVAR ARG; INTEGER X,Y);
BEGIN
LOOK(ARG,STATUS,X,Y);
RESP(ARG,STATUS,"RELOOK");
END;
SIMPLE MESSAGE PROCEDURE XEQ(STRING ARGSTR; REFERENCE BOOLEAN FLAG);
FLAG←¬SUBLNK(ARGSTR);
SIMPLE MESSAGE PROCEDURE SETVAL(STRING AR; INTEGER A;
REFERENCE BOOLEAN F);
BEGIN
EDGINIT ← FALSE;
IF F ← (I ← SLINK(AR))>0 THEN
START_CODE DEFINE MOVE="'200000000000";
MOVE 1,A;
MOVE 2,I;
MOVEM 1,(2);
END;
END;
MESSAGE PROCEDURE GETDATA(LIST OBJS; REFERENCE BOOLEAN FLAG);
BEGIN
FLAG ← ¬XGETD(OBJS, JOB);
END;
MESSAGE PROCEDURE GETSTATUS(LIST OBJS;REAL TOP,BOT,LEFT,RT;
REFERENCE BOOLEAN FLAG);
BEGIN
FLAG ← ¬XGETS(OBJS,TOP,BOT,LEFT,RT, JOB);
END;
INTERNAL PROCEDURE RESTART;
BEGIN
AFLAG←TRUE;
DISINT;
SEINT(0,0,0,0, 0);
INITLPS(GIOWD(LPSFRE));
INITTV;
INP ← NULL;
DEFLT;
END;
SIMPLE MESSAGE PROCEDURE DISK(STRING NAME; REFERENCE BOOLEAN FLAG);
FLAG ← INITDK(NAME);
INTERNAL PROCEDURE START;
XSTRT ← YSTRT ← 0;
COMMENT MAIN PROGRAM STARTS HERE;
PTYDPY ← DISDEV;
ACCOMINIT ← INIT ← FALSE;
SETBREAK(1,LF&" ,",NULL,"I");
SETBREAK(2,"0123456789.-",NULL,"X");
SETBREAK(3,".",NULL,"I");
SETBREAK(4,LF,"","IA");
SETBREAK(5," ",NULL,"XR");
TVWORD ← 0;
INTMAP(INTTTY_INX,INTSTR,0);
INTMAP(INTMAIL_INX,INTSTR,0);
SAIINT(TRUE,FALSE,TRUE);
ENABLE(INTTTY_INX);
ENABLE(INTMAIL_INX);
YES_EDGE ← TRUE;
PUT_DATA(0,0,"EDGE");
RESTART;
INPT: WHILE (I ← GET_ENTRY('40120,"","EDGE","")) DO
BEGIN
JOB ← GET_DATA(1,I);
I ← QUEUE('600,I);
END;
IF AFLAG THEN
BEGIN
OUTSTR("*"&CRLF);
AFLAG ← FALSE;
END;
WHILE LENGTH(ANS←INCHSL(FLAGX))∧¬FLAGX DO
BEGIN
INP←INP&ANS&LF;
ANS←NULL;
END;
IF ¬LENGTH(INP) THEN GO TO XEQL;
JOB←"TTY";
AFLAG ← TRUE;
WHILE LENGTH(ANS←SCAN(INP,4,BRK)) DO
BEGIN
IF ¬LENGTH(VERB←SCN(ANS,BRK)) THEN GO TO INPTX;
FOR I ← 0 STEP 1 UNTIL CX DO IF EQU(VERB,COMND[I]) THEN DONE;
IF I>CX THEN GO TO ERRCOM;
BITS ← STATBITS[I];
IF BITS LAND 2 THEN
BEGIN
IF BRK=LF THEN GO TO ERRARG ELSE ARGSTR←SCN(ANS,BRK);
IF BITS LAND 4 THEN IF FLAGX THEN
ARG←(IF FLAGY THEN FOOL(REALSCAN(ARGSTR,LF))
ELSE CVD(ARGSTR)) ELSE GO ERRARG ELSE
ARGSTR ← ARGSTR[1 FOR 6];
IF BITS LAND '10 THEN
BEGIN
IF BRK=LF THEN GO TO ERRARG ELSE
ARGTWO←SCN(ANS,BRK);
IF BITS LAND '20 THEN IF FLAGX THEN
ARGT←(IF FLAGY THEN
FOOL(REALSCAN(ARGTWO,LF))
ELSE CVD(ARGTWO)) ELSE GO TO ERRARG
ELSE ARGTWO ← ARGTWO[1 FOR 6];
END;
END;
IARG ← IF ARG>0 THEN CVI(ARG) ELSE IF ARG=0 THEN NIL ELSE
EVERY;
FLAG ← TRUE;
CASE I OF
BEGIN
BEGIN
IF LENGTH(ANS) THEN
BEGIN
INP ← SCAN(ANS,5,BRK);
DSKSTRING ← ANS[1 TO ∞-1];
END;
DISK(DSKSTRING,FLAG);
IF ¬FLAG THEN
OUTSTR(CRLF&DSKSTRING&" NOT FOUND"&CRLF);
END;
SETVAL(ARGSTR,ARGT, FLAG);
FIND(IARG);
FIT(IARG);
COMPACT(IARG);
REJECT(IARG);
RELOOK(IARG,0,0);
FINE(IARG);
GETDATA(IF IARG=EVERY THEN CVLIST(FNDBLB) ELSE
{{IARG}},FLAG);
GETVAL(ARGSTR,FLAG);
IF YES_CUR THEN ISSUE(7,"EDGE","CURVE",
MESSAGE GLBDMP(IF IARG=EVERY THEN BLOBS
ELSE {IARG})) ELSE
OUTSTR("CURVE FITTER NOT AVAILABLE"&CRLF);
GETSTATUS(IF IARG=EVERY THEN CVLIST(FNDBLB) ELSE
{{IARG}},INTSCAN(ANS,BRK),INTSCAN(ANS,BRK),
INTSCAN(ANS,BRK),INTSCAN(ANS,BRK),FLAG);
END;
IF ¬FLAG THEN
ERRARG: OUTSTR("ARG ERR"&TAB&ANS&CRLF);
INPTX: END;
GO TO INPT;
XEQL: IF GET_ENTRY('40120,NULL,"EDGE",NULL) THEN GO TO INPT;
IF LENGTH(ANS←INCHSL(FLAGX))∧¬FLAGX THEN
BEGIN
INP←INP&ANS&LF;
GO TO INPT;
END;
INTWAIT;
GO TO INPT;
ERRCOM: IF SUBLNK(VERB) THEN OUTSTR("COM ERR "&VERB&CRLF);
GO TO INPT;
END;